SAME-SEX AND RACE EQUITY ANALYSIS

#There were a few outlyers that were filtered out to maintain a more observable color gradient. Palm Springs was the largest and had 17.62% same-sex couples.

USA

Individual in same-sex relationship personal income by race

Individual in opposite-sex relationship personal income by race

FLORIDA

Individual in same-sex relationship personal income by race

Individual in opposite-sex relationship personal income by race

CALIFORNIA

#There were a few outlyers that were filtered out to maintain a more observable color gradient. Palm Springs was the largest and had 160 same-sex couples. Why are there odd numbers?

Individual in same-sex relationship personal income by race

Individual in opposite-sex relationship personal income by race

EQUITY ANALYSIS BETWEEN SAME-SEX COUPLES AND OPPOSITE-SEX COUPLES DISAGGREGATED BY RACE

White Alone

Black or African American alone

Asian American Alone

American Indian alone

Two or More Races

Same-Sex gender Equity Analysis

Equity Analysis of single gender and relationship type

{r} # census_race_categories <- # c( # "White alone", # "Black or African American alone", # "American Indian alone", # "Alaska Native alone", # "American Indian and Alaska Native tribes specified; or American Indian or Alaska Native, not specified and no other races", # "Asian alone", # "Native Hawaiian and Other Pacific Islander alone", # "Some Other Race alone", # "Two or More Races") #

{r setup, include=FALSE} # knitr::opts_chunk$set( # echo = F, # message = FALSE, # warning = FALSE # ) #

{r library} # library(tidyverse) # library(sf) # library(tigris) # library(mapview) # library(leaflet) # library(censusapi) # library(gtools) # Sys.setenv(CENSUS_KEY="9fbd5ddd430b595b8f3715733cae2b75c18be92e") #

## SAME-SEX AND RACE EQUITY ANALYSIS

{r loading US ACS} # # pums_2019_1yru <- getCensus( # # name = "acs/acs1/pums", # # vintage = 2019, # # region = "public use microdata area:*", # # regionin = "state:1,2,4,5,6,8,9,10,11,12,13,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,44,45,46,47,48,49,50,51,53,54,55,56", # # vars = c( # # "SERIALNO", #Unique ID for each household # # "SPORDER", #Person number # # "PWGTP", #Total number of people # # "CPLT", #Couple Type # # "PINCP", #Total Persons Income # # "RAC1P" #Recorded Detailed Race Code # # ) # # ) # # saveRDS(pums_2019_1yru, "usa_pums.rds") #

{r ACS US} # pums_2019_1yru <- readRDS("usa_pums.rds") # us_pumas <- # pumas(state = NULL, cb = T, progress_bar = F) # counties <- # counties(state = NULL, cb = T, progress_bar = F) # us_pumas <- # us_pumas %>% # st_centroid() %>% # .[counties, ] %>% # st_drop_geometry() %>% # left_join(us_pumas %>% select(GEOID10)) %>% # st_as_sf() # us_pums <- # pums_2019_1yru %>% # mutate( # PUMA = str_pad(public_use_microdata_area,5,"left","0") # ) %>% # filter(PUMA %in% us_pumas$PUMACE10) #

{r cleaned us} # cleaned <- us_pums %>% # mutate( # SPORDER = as.numeric(SPORDER), # CPLT = as.numeric(CPLT) # ) %>% # filter( # (SPORDER %in% 1:2), #Only using head of household data so that household income is not double counted thus skewing results. # (CPLT %in% 1:4)) #filtering out N/A #

{r us pop data} # us_pums_pop <- # cleaned %>% # filter( # (RAC1P %in% c(1,2,3,6,9))) %>% # mutate( # same_sex = ifelse( # (CPLT == 2)|(CPLT == 4), # 1, # 0 # )) %>% # group_by(PUMA) %>% # summarize( # samesex = sum(same_sex, na.rm = T), # total_pop = sum(CPLT, na.rm = T) # ) %>% # mutate( # percent = samesex/total_pop*100 # ) %>% # left_join( # us_pumas %>% # select(PUMACE10), # by = c("PUMA" = "PUMACE10") # ) %>% # st_as_sf() #

{r map US} # couple_pal <- colorNumeric( # palette = "Blues", # domain = # c(0,5) # ) # leaflet() %>% # addProviderTiles(providers$CartoDB.Positron) %>% # addPolygons( # data = us_pums_pop, # fillColor = ~couple_pal (percent), # color = "white", # opacity = 0.5, # fillOpacity = 0.75, # weight = 1, # label = ~paste0( # round(percent*100)/100, # "% same-sex couples" # ), # highlightOptions = highlightOptions( # weight = 2, # opacity = 1 # ) # ) %>% # addLegend( # data = us_pums_pop, # pal = couple_pal, # values = 0:5, # title = "% same-sex relationships" # ) # # # # #{r}

ca_income_race <-

1:9 %>%

map_dfr(function(x){

race <- cleaned %>%

mutate(

RAC1P = as.numeric(RAC1P)

) %>%

filter(

(RAC1P %in% census_race_categories[x])) %>%

mutate(

PWGTP = as.numeric(PWGTP),

HINCP = as.numeric(HINCP),

Same_sex_household = ifelse(

(CPLT == 2)|(CPLT == 4),

“Same sex couple”,

“Opposite sex couple”

),

income = ifelse(

(HINCP <= 10000),

“$10,000 or less”,

HINCP

),

income = ifelse(

(HINCP > 10000 & HINCP <= 20000),

“$10,001 to $20000”,

income

),

income = ifelse(

(HINCP > 20000 & HINCP <= 30000),

“$20,001 to $30,000”,

income

),

income = ifelse(

(HINCP > 30000 & HINCP <= 40000),

“$30,001 to $40,000”,

income

),

income = ifelse(

(HINCP > 40000 & HINCP <= 50000),

“$40,001 to $50,000”,

income

),

income = ifelse(

(HINCP > 50000 & HINCP <= 75000),

“$50,001 to $75,000”,

income

),

income = ifelse(

(HINCP > 75000 & HINCP <= 100000),

“$75,001 to $100,000”,

income

),

income = ifelse(

(HINCP > 100000 & HINCP <= 150000),

“$100,001 to $150,000”,

income

),

income = ifelse(

(HINCP > 150000 & HINCP <= 200000),

“$150,001 to $200,000”,

income

),

income = ifelse(

(HINCP > 200000),

“$200,001 or more”,

income

)) %>%

group_by(income, Same_sex_household) %>%

summarize(estimate = sum(PWGTP)) %>%

ggplot() +

geom_bar(

aes(

x = income %>% factor(mixedsort(order)),

y = estimate,

fill = Same_sex_household

),

stat = “identity”,

position = “stack”

) +

labs(

x = “Household income”,

y = “Number of households”,

title = “Bay Area household income by couple type”,

fill = “Couple Type”

) +

coord_flip() +

theme(

legend.position = “bottom”,

legend.direction = “vertical”

) +

guides(

fill = guide_legend(

reverse = T

)

)

})

# # # # # getCensus( # name = "acs/acs1/pums", # vintage = 2019, # region = "public use microdata area:*", # regionin = "state:06", # vars = c( # "SERIALNO", #Unique ID for each household # "SPORDER", #Person number # "PWGTP", #Total number of people # "WGTP", #Housing Weight # "HINCP", #Household Income # "CPLT", #Couple Type # "FINCP", #Family Income # "PINCP", #Total Persons Income # "RAC1P" #Recorded Detailed Race Code # ) # ) %>% # select(!c(GEO_ID,state,NAME) & !ends_with(c("EA","MA","M"))) %>% # pivot_longer( # ends_with("E"), # names_to = "name", # values_to = "estimate" # ) %>% # left_join( # ca_pums %>% # select(name, label) # ) %>% # select(-name) %>% # separate( # label, # into = c(NA,NA,"income"), # sep = "!!" # ) %>% # filter(!is.na(income)) %>% # mutate(race = census_race_categories[x]) # }) #

(HINCP < 10000),

“Less than 10,000”,

(HINCP > 10000),

“More than 10,000”,

0

))

# IR = ifelse(

# SERIALNO == SERIALNO|RAC1P!=RAC1P,

# 1,

# 0

# )

# )

# IRC_compare <- #Attempting to pull out Interracial couples into new data set so we can compare races

# ca_pums_IRC %>%

# mutate(

# PWGTP = as.numeric(PWGTP),

# SERIALNO = as.numeric(SERIALNO)) %>%

# if(SERIALNO == SERIALNO) {

# mutate(

# PWGTP = as.numeric(PWGTP),

# Same_sex_household = ifelse(

# (CPLT == 2)|(CPLT == 4),

# 1,

# 0

# ))

# }

##Can’t figure out how to separate interracial couples–Trying to do if statement

#if {same serialno but different races put them in this data set or create new column}

# #{r}

ca_pums_IRC %>%

group_by(HINCP, Same_sex_household) %>%

summarize(estimate = sum(PWGTP)) %>%

ggplot() +

geom_bar(

aes(

x = HINCP,

y = estimate,

fill = Same_sex_household

),

stat = “identity”,

position = “stack”

) +

labs(

x = “Household income”,

y = “Number of households”,

title = “Bay Area household income by couple type”,

fill = “Couple Type”

)

# # # # # #{r}

census_race_categories <- data.frame(

code = c(1,2,3,4,5,6,7,8,9),

category =

c(

“White alone”,

“Black or African American alone”,

“American Indian alone”,

“Alaska Native alone”,

“American Indian and Alaska Native tribes specified; or American Indian or Alaska Native, not specified and no other races”,

“Asian alone”,

“Native Hawaiian and Other Pacific Islander alone”,

“Some Other Race alone”,

“Two or More Races”

))

# #{r}

census_race_categories <-

c(

“White alone”,

“Black or African American alone”,

“American Indian alone”,

“Alaska Native alone”,

“American Indian and Alaska Native tribes specified; or American Indian or Alaska Native, not specified and no other races”,

“Asian alone”,

“Native Hawaiian and Other Pacific Islander alone”,

“Some Other Race alone”,

“Two or More Races”)

# #{r}

ca_income_race <-

1:9 %>%

map_dfr(function(x){

getCensus(

name = “acs/acs1/pums”,

vintage = 2019,

region = “public use microdata area:*“,

regionin = “state:06”,

vars = c(

“SERIALNO”, #Unique ID for each household

“SPORDER”, #Person number

“PWGTP”, #Total number of people

“WGTP”, #Housing Weight

“HINCP”, #Household Income

“CPLT”, #Couple Type

“FINCP”, #Family Income

“PINCP”, #Total Persons Income

“RAC1P” #Recorded Detailed Race Code

)

) %>%

select(!c(GEO_ID,state,NAME) & !ends_with(c(“EA”,“MA”,“M”))) %>%

pivot_longer(

ends_with(“E”),

names_to = “name”,

values_to = “estimate”

) %>%

left_join(

ca_pums %>%

select(name, label)

) %>%

select(-name) %>%

separate(

label,

into = c(NA,NA,“income”),

sep = “!!”

) %>%

filter(!is.na(income)) %>%

mutate(race = census_race_categories[x])

})

# #{r}

ca_cup <-

getCensus(

name = “acs/acs1/pums”,

vintage = 2019,

region = “public use microdata area:*“,

regionin = “state:06”,

vars = c(

“SERIALNO”, #Unique ID for each household

“SPORDER”, #Person number

“PWGTP”, #Total number of people

“WGTP”, #Housing Weight

“HINCP”, #Household Income

“CPLT”, #Couple Type

“FINCP”, #Family Income

“PINCP”, #Total Persons Income

“RAC1P”) #Recorded Detailed Race Code

) %>%

left_join(

ca_pums_IRC %>%

select(SERIALNO, public_use_microdata_area)

)

# %>% # select(-name) %>% # separate( # label, # into = c(NA,NA,"income"), # sep = "!!" # ) %>% # filter(!is.na(income)) #

,

White_Low_Income = ifelse(

(RAC1P == 1) & (HINCP > 100000),

1,

0

),

Not_White_Low_Income = ifelse(

(RAC1P != 1) & (HINCP > 100000),

1,

0))

# #{r}

bay_pums_couple <-

cleaned %>%

Same_sex_household = ifelse(

(CPLT == 2)|(CPLT == 4),

WGTP,

0)

# %>%

# group_by(PUMA) %>%

# summarize(

# PERSON1 =

# sum(Person1, na.rm =T)

# )

#

{r} # bay_pums_couple <- # cleaned %>% # mutate( # WGTP = as.numeric(WGTP), # SPORDER = as.numeric(SPORDER), # partner1 = ifelse( # (SPORDER == 1), # WGTP, # 0 # ), # partner2 = ifelse( # (SPORDER == 2), # WGTP, # 0 # ) %>% # group_by(PUMA) %>% # summarize( # partner1 = # sum(partner1, na.rm =T), # partner2 = # sum(partner2, na.rm =T)) # ) #

,

Same_sex_household = ifelse(

(HINCP < 100000) &

(CPLT == 2)|(CPLT == 4),

WGTP,

0

),

Opposite_sex_household = ifelse(

(HINCP < 100000) &

(CPLT == 1)|(CPLT == 3),

WGTP,

0

),

White = ifelse(

(SERIALNO == 1) &

(RAC1P == 1),

WGTP,

0

)

) %>%

group_by(PUMA) %>%

summarize(

sum_same_sex_household =

sum(Same_sex_household, na.rm =T),

sum_opposite_sex_household =

sum(Opposite_sex_household, na.rm =T),

partner1 =

sum(partner1, na.rm =T),

partner2 =

sum(partner2, na.rm =T)%>%

left_join(

bay_pumas %>%

select(PUMACE10),

by = c(“PUMA” = “PUMACE10”)

) %>%

st_as_sf()

)

# #{r}

bay_pums_couple <-

cleaned %>%

mutate(

WGTP = as.numeric(WGTP),

partner1 = ifelse(

(SPORDER == 1),

WGTP,

0

),

partner2 = ifelse(

(SPORDER == 2),

WGTP,

0

),

Same_sex_household = ifelse(

(HINCP < 100000) &

(CPLT == 2)|(CPLT == 4),

WGTP,

0

),

Opposite_sex_household = ifelse(

(HINCP < 100000) &

(CPLT == 1)|(CPLT == 3),

WGTP,

0

),

White = ifelse(

(SERIALNO == 1) &

(RAC1P == 1),

WGTP,

0

)

# # #{r}

acs_vars_2019_5yr <-

listCensusMetadata(

name = “2019/acs/acs5”,

type = “variables”

)

# # #{r}

veteran <-

getCensus(

name = “acs/acs5”,

vintage = 2019,

region = “county:055”,

regionin = “state:06”,

vars = “group(S2101)”

) %>%

select(!c(GEO_ID,state,NAME,county) & !ends_with(c(“EA”,“MA”,“M”))) %>%

pivot_longer(

ends_with(“E”),

names_to = “name”,

values_to = “estimate”

) %>%

left_join(

acs_vars_2019_5yr %>%

select(name, label)

)

```

##How would we filter out just first two people to determine their races? Is sample size too small?

##Veterans, Jobs, Race< which war, income